home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H107.ZIP / CLO.ZIP / CLO-FI.LSP
Lisp/Scheme  |  1991-05-12  |  1KB  |  46 lines
  1. ;* CURRENT LAYER OFFSET
  2. ;* Provides offsets to current layer.
  3. ;* Kent M. Taylor  5/90
  4. ;* Revised 4/91
  5.  
  6. (defun C:CLO ( / ce cl ent side e1 e2 pt1 )
  7.   (setq ce (getvar "cmdecho"))
  8.   (setvar "cmdecho" 0)
  9.   (setq cl (getvar "clayer"))
  10.   (setq dist nil 
  11.         dist (getreal "\nEnter offset distance or RETURN for through point: "))
  12.   (while 
  13.     (setq ent (entsel "\nSelect object to offset: "))
  14.     (if ent
  15.       (progn
  16.         (if (not dist)
  17.           (progn
  18.             (setq pt1 (getpoint "\nThrough point: "))
  19.             (mark)
  20.             (command "OFFSET" "T" ent pt1 "")
  21.           );progn
  22.           (progn
  23.             (setq side (getpoint "\nIndicate offset side: "))
  24.             (mark)
  25.             (command "OFFSET" dist ent side "")
  26.           );progn
  27.           );if
  28.         (setq e2 (entnext e1))
  29.         (command "CHANGE" e2 "" "P" "LA" cl "")
  30.       );progn
  31.     );if
  32.   );while
  33.   (setvar "cmdecho" ce)
  34. ; (setq dist nil)
  35.   (princ)
  36. );defun
  37. (princ)
  38.  
  39. (defun mark ()
  40.   (command nil nil nil "POINT" "@")                 ;place database marker
  41.   (setq e1 (entlast))                               ;set as last entity
  42.   (entdel e1)                                       ;delete
  43. )
  44.  
  45. (C:CLO)
  46.